home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / elan1v5.arc / DEMO.ARC / KALEIDOS.E < prev    next >
Text File  |  1989-03-10  |  1KB  |  74 lines
  1.  
  2. kaleidoscope:
  3.   read a text;
  4.   clear screen;
  5.   spread text over the screen;
  6.   remove cursor.
  7.  
  8.   read a text:
  9.     TEXT VAR t;
  10.     put ("Text, please: ");
  11.     get (t, 40).
  12.   
  13.   clear screen:
  14.     put (ascii (1)).
  15.   
  16.   spread text over the screen:
  17.     start in the middle;
  18.     WHILE there is text left
  19.     REP
  20.       snip its head off;
  21.       repeat its head symmetrically;
  22.       choose a new position
  23.     ENDREP.
  24.   
  25.     start in the middle:
  26.       INT CONST midx :: 39;
  27.       INT CONST midy :: 10;
  28.       INT VAR i :: 1;
  29.       INT VAR j :: 0.
  30.     
  31.     there is text left:
  32.       t <> "".
  33.     
  34.     snip its head off:
  35.       TEXT CONST head :: HEAD t;
  36.       t := TAIL t.
  37.     
  38.     repeat its head symmetrically:
  39.       show head in 4 orientations;
  40.       mirror position;
  41.       show head in 4 orientations;
  42.       mirror position.
  43.     
  44.       show head in 4 orientations:
  45.         UPTO 4
  46.         REP
  47.           show head;
  48.           rotate left
  49.         ENDREP.
  50.       
  51.         show head:
  52.           cursor (midx + i, midy + j);
  53.           put (head).
  54.         
  55.         rotate left:
  56.           INT CONST oldi :: i;
  57.           i := - j;
  58.           j := oldi.
  59.         
  60.       mirror position:
  61.         j := - j.
  62.       
  63.     choose a new position:
  64.       j INCR 1;
  65.       IF j = i
  66.       THEN
  67.         i INCR 1;
  68.         j := 0
  69.       FI.
  70.     
  71.   remove cursor:
  72.     cursor (1, 2 * midy).
  73.   
  74. ⇦